home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / vmode13.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-04  |  4.1 KB  |  161 lines
  1.  
  2. {$A+}   { Align data }
  3. {$B-}   { Boolean evaluation }
  4. {$E+}   { 80x87 emulator }
  5. {$F-}   { Force FAR calls }
  6. {$G+}   { 80286 code }
  7. {$I-}   { I/O checking }
  8. {$K-}   { Smart Callbacks }
  9. {$N-}   { 80x87 code }
  10. {$O-}   { Overlays allowed }
  11. {$P-}   { Open parameters }
  12. {$T-}   { Typed pointers }
  13. {$V-}   { String VAR checking }
  14. {$W-}   { Windows stack frame for real mode }
  15. {$X+}   { Extended syntax }
  16.  
  17. {$IFDEF DEBUG}
  18.     {$D+}   { Debug information }
  19.     {$L+}   { Local symbols }
  20.     {$Q+}   { Overflow checking }
  21.     {$R+}   { Range checking }
  22.     {$S+}   { Stack checking }
  23.     {$Y+}   { Symbol reference information }
  24. {$ELSE}
  25.     {$D-}   { Debug information }
  26.     {$L-}   { Local symbols }
  27.     {$Q-}   { Overflow checking }
  28.     {$R-}   { Range checking }
  29.     {$S-}   { Stack checking }
  30.     {$Y-}   { Symbol reference information }
  31. {$ENDIF}
  32.  
  33. {$C Moveable Demandload Discardable} { Code Segment attributes }
  34.  
  35. {$M 4096,4096}
  36.  
  37. PROGRAM VMode_13h;
  38.  
  39. (*
  40.   This short example switches Windows first in a 80x25 character text mode
  41.   and later in a 320x200 graphics mode using two undocumented functions.
  42.   Note that it requires a VGA compatible graphics adapter.
  43.   This program runs well under Windows 3.1, but I haven't tested it with
  44.   Windows 3.0.
  45.  
  46.   As usual, if you're using it, you do it on your own risk.
  47.  
  48.   Olaf Hess, CIS: 100 031, 35 36.
  49. *)
  50.  
  51. USES WinTypes, WinProcs;
  52.  
  53. TYPE
  54.     TOneChar = RECORD
  55.         chChar : Char;
  56.         byAttr : Byte;
  57.     END;
  58.  
  59.     abyTextmode = ARRAY [0..1999] OF TOneChar;
  60.  
  61. VAR
  62.     SegA000, SegB800 : Word;
  63.     pToTextMode : ^abyTextMode;
  64.  
  65. (* ---- *)
  66. { Undocumented functions. See "Undocumented Windows" by Schulman, Maxey and
  67.   Pietrek for more info. }
  68.  
  69. PROCEDURE Death (hDesktopDC: hDC); FAR;
  70.     EXTERNAL 'GDI' index 121;
  71. PROCEDURE Resurrection (hDesktopDC: hDC; w1, w2, w3, w4, w5, w6: Word); FAR;
  72.     EXTERNAL 'GDI' index 122;
  73.  
  74. PROCEDURE __A000H; FAR;
  75.     EXTERNAL 'KERNEL' index 174;
  76. PROCEDURE __B800H; FAR;
  77.     EXTERNAL 'KERNEL' index 182;
  78.  
  79. (* ---- *)
  80.  
  81. PROCEDURE PutPixel (wXPos, wYPos: Word; byColor: Byte);
  82. { Set a pixel. The upper left corner is (00,00) }
  83. BEGIN
  84.     Mem [SegA000:Word (320 * wYPos + wXPos)] := byColor;
  85. END; { PutPixel }
  86.  
  87. (* ---- *)
  88.  
  89. PROCEDURE WriteChar (wXPos, wYPos: Word; chChar: Char; byAttr: Byte);
  90. { Write a character to screen. The upper left corner is (01, 01) }
  91. BEGIN
  92.     IF (wXPos > 0) THEN Dec (wXPos);
  93.     IF (wYPos > 0) THEN Dec (wYPos);
  94.     pToTextMode^[(wYPos * 80) + wXPos].chChar := chChar;
  95.     pToTextMode^[(wYPos * 80) + wXPos].byAttr := byAttr;
  96. END; { WriteChar }
  97.  
  98. (* ---- *)
  99.  
  100. VAR
  101.     wX, wY, i : Word;
  102.     hDesktopDC : hDC;
  103.     dwWait : LongInt;
  104.  
  105. BEGIN
  106.     { Get selector for segment $A000 }
  107.     SegA000 := Ofs (__A000H);
  108.  
  109.     { Get selector for segment $B800 }
  110.     SegB800 := Ofs (__B800H);
  111.  
  112.     { Pointer points to beginning of segment $B800 }
  113.     pToTextMode := Ptr (SegB800, 0);
  114.  
  115.     { Get DC for desktop window }
  116.     hDesktopDC := GetDC (GetDesktopWindow);
  117.  
  118.     { Switch to 80x25 text mode }
  119.     Death (hDesktopDC);
  120.  
  121.     i := 0;
  122.  
  123.     { Write some characters on the screen }
  124.     FOR wY := 1 TO 25 DO
  125.         FOR wX := 1 TO 80 DO
  126.             BEGIN
  127.                 WriteChar (wX, wY, Char ((i MOD 26) + 65), Byte (i MOD 256));
  128.                 Inc (i);
  129.             END; { for }
  130.  
  131.     { Wait a while }
  132.     FOR dwWait := 0 TO 2000000 DO
  133.         INLINE ($90/$90/$90); { NOP, NOP, NOP }
  134.  
  135.     { Set video mode $13 (320x200 in 256 colors) }
  136.     ASM
  137.         mov ax, $0013;
  138.         Int $10
  139.     END; { asm }
  140.  
  141.     { Paint palette }
  142.     FOR wY := 0 TO 200 DO
  143.         FOR wX := 0 TO 300 DO
  144.             PutPixel (wX, wY, Byte (wX));
  145.  
  146.     { Wait a while }
  147.     FOR dwWait := 0 TO 2000000 DO
  148.         INLINE ($90/$90/$90); { NOP, NOP, NOP }
  149.  
  150.     { Restore Windows' video mode }
  151.     Resurrection (hDesktopDC, 0, 0, 0, 0, 0, 0);
  152.  
  153.     { Release desktop DC }
  154.     ReleaseDC (GetDesktopWindow, hDesktopDC);
  155.  
  156.     { Force Windows to repaint all visible windows }
  157.     InvalidateRect (0, NIL, TRUE);
  158.     UpdateWindow (0);
  159. END. { VMode_13h }
  160.  
  161.